home *** CD-ROM | disk | FTP | other *** search
/ SPACE 1 / SPACE - Library 1 - Volume 1.iso / program / 355 / source / ifsdemo / ifs.mod < prev    next >
Text File  |  1990-02-02  |  13KB  |  435 lines
  1. MODULE IFS;
  2.  
  3. (* This is a demonstration of Iterated Function Systems based on an article
  4.    entitled 'A Better Way to Compress Images' by Michael F. Barnsley and
  5.    Alan D. Sloan, Byte Magazine, Vol. 13, No. 1. - Mike Long  1/15/88 *)
  6.  
  7. FROM SYSTEM IMPORT ADR, ADDRESS;
  8.  
  9. FROM AESevents IMPORT EvntMulti;
  10.  
  11. FROM AESGraphics IMPORT GrafGrowbox,
  12.                         GrafShrinkbox;
  13.  
  14. FROM AESMenu IMPORT MenuBar,
  15.                     MenuTnormal;
  16.  
  17. FROM AESResource IMPORT RsrcGAddr;
  18.  
  19. FROM AESWindows IMPORT WindGet,
  20.                        WindUpdate,
  21.                        WindCreate,
  22.                        WindOpen,
  23.                        WindClose,
  24.                        WindDelete,
  25.                        WindSet;
  26.  
  27. FROM BitStuff IMPORT SetBit,
  28.                      TestBit;
  29.  
  30. FROM GEMConstants IMPORT WFWORKXYWH,
  31.                          BEGUPDATE,
  32.                          ENDUPDATE,
  33.                          MUKEYBD,
  34.                          MUMESAG,
  35.                          MNSELECTED,
  36.                          NAME,
  37.                          WFNAME;
  38.  
  39. FROM GEMProcs IMPORT GEMInit,
  40.                      GEMTerm,
  41.                      GEMRec,
  42.                      GEMState,
  43.                      ShowMouse,
  44.                      HideMouse,
  45.                      DoDialog,
  46.                      AddrToInts;
  47.  
  48. FROM VDIControl IMPORT VswrMode;
  49.  
  50. FROM VDIOutput IMPORT VBar,
  51.                       VPmarker;
  52.  
  53. FROM VDISettings IMPORT VsfInterior,
  54.                         VsfStyle,
  55.                         VsfColor,
  56.                         VsmType,
  57.                         VsmHeight,
  58.                         VsmColor;
  59.  
  60. FROM XBIOSMisc IMPORT random;
  61.  
  62. CONST MAINMENU = 0;     (* menu tree *)
  63.       INFO     = 8;     (* STRING in tree MAINMENU *)
  64.       QUIT     = 17;    (* STRING in tree MAINMENU *)
  65.       TRIANGLE = 19;    (* STRING in tree MAINMENU *)
  66.       FERN     = 20;    (* STRING in tree MAINMENU *)
  67.       TREE     = 21;    (* STRING in tree MAINMENU *)
  68.       SQUARE   = 22;    (* STRING in tree MAINMENU *)
  69.       INFOBOX  = 1;     (* form/dialog *)
  70.       OK       = 5;     (* BUTTON in tree INFOBOX *)
  71.  
  72. (* A DataRec holds the data for one image. Notice that, even though the images
  73.    are fairly complex, the data for each image is only 32 REALs. Fractals are
  74.    wonderful things! *)
  75.  
  76. TYPE DataRec = RECORD
  77.                   a,b,c,d,e,f,p : ARRAY [1..4] OF REAL;
  78.                   xs,ys,xo,yo   : REAL;
  79.                END;
  80.  
  81. VAR xdesk, ydesk, wdesk, hdesk : INTEGER;
  82.     dummy                      : INTEGER;
  83.     windopen                   : BOOLEAN; (* Is a window open? *)
  84.     windhandle                 : INTEGER; (* This is it's handle *)
  85.     triangle                   : DataRec;
  86.     fern                       : DataRec;
  87.     tree                       : DataRec;
  88.     square                     : DataRec;
  89.  
  90. PROCEDURE InitData();
  91.  
  92. (* As you might guess, this procedure plugs the proper values into the image
  93.    data records. Fields a, b, c, d, e, and f are the fractal data. Field p is
  94.    the probablity that any particular set of data will be used. Fields xs and
  95.    ys are the scaling factors that scale each image to the screen. Fields xo
  96.    and yo are offsets that center each image on the screen. *)
  97.  
  98. BEGIN
  99.    triangle.a[1] := 0.5;
  100.    triangle.b[1] := 0.0;
  101.    triangle.c[1] := 0.0;
  102.    triangle.d[1] := 0.5;
  103.    triangle.e[1] := 0.5;
  104.    triangle.f[1] := 0.5;
  105.    triangle.p[1] := 0.34;
  106.    triangle.a[2] := 0.5;
  107.    triangle.b[2] := 0.0;
  108.    triangle.c[2] := 0.0;
  109.    triangle.d[2] := 0.5;
  110.    triangle.e[2] := 1.0;
  111.    triangle.f[2] := 0.0;
  112.    triangle.p[2] := 0.67;
  113.    triangle.a[3] := 0.5;
  114.    triangle.b[3] := 0.0;
  115.    triangle.c[3] := 0.0;
  116.    triangle.d[3] := 0.5;
  117.    triangle.e[3] := 0.0;
  118.    triangle.f[3] := 0.0;
  119.    triangle.p[3] := 1.0;
  120.    triangle.a[4] := 0.0;
  121.    triangle.b[4] := 0.0;
  122.    triangle.c[4] := 0.0;
  123.    triangle.d[4] := 0.0;
  124.    triangle.e[4] := 0.0;
  125.    triangle.f[4] := 0.0;
  126.    triangle.p[4] := 1.0;
  127.    triangle.xs := 300.0;
  128.    triangle.ys := 300.0;
  129.    triangle.xo := 20.0;
  130.    triangle.yo := 36.0;
  131.    fern.a[1] := 0.85;
  132.    fern.b[1] := 0.04;
  133.    fern.c[1] := -0.04;
  134.    fern.d[1] := 0.85;
  135.    fern.e[1] := 0.0;
  136.    fern.f[1] := 1.6;
  137.    fern.p[1] := 0.85;
  138.    fern.a[2] := -0.15;
  139.    fern.b[2] := 0.28;
  140.    fern.c[2] := 0.26;
  141.    fern.d[2] := 0.24;
  142.    fern.e[2] := 0.0;
  143.    fern.f[2] := 0.44;
  144.    fern.p[2] := 0.92;
  145.    fern.a[3] := 0.2;
  146.    fern.b[3] := -0.26;
  147.    fern.c[3] := 0.23;
  148.    fern.d[3] := 0.22;
  149.    fern.e[3] := 0.0;
  150.    fern.f[3] := 1.6;
  151.    fern.p[3] := 0.99;
  152.    fern.a[4] := 0.0;
  153.    fern.b[4] := 0.0;
  154.    fern.c[4] := 0.0;
  155.    fern.d[4] := 0.16;
  156.    fern.e[4] := 0.0;
  157.    fern.f[4] := 0.0;
  158.    fern.p[4] := 1.0;
  159.    fern.xs := 35.0;
  160.    fern.ys := 35.0;
  161.    fern.xo := 312.0;
  162.    fern.yo := 8.0;
  163.    tree.a[1] := 0.42;
  164.    tree.b[1] := 0.42;
  165.    tree.c[1] := -0.42;
  166.    tree.d[1] := 0.42;
  167.    tree.e[1] := 0.0;
  168.    tree.f[1] := 0.2;
  169.    tree.p[1] := 0.4;
  170.    tree.a[2] := 0.42;
  171.    tree.b[2] := -0.42;
  172.    tree.c[2] := 0.42;
  173.    tree.d[2] := 0.42;
  174.    tree.e[2] := 0.0;
  175.    tree.f[2] := 0.2;
  176.    tree.p[2] := 0.8;
  177.    tree.a[3] := 0.1;
  178.    tree.b[3] := 0.0;
  179.    tree.c[3] := 0.0;
  180.    tree.d[3] := 0.1;
  181.    tree.e[3] := 0.0;
  182.    tree.f[3] := 0.2;
  183.    tree.p[3] := 0.95;
  184.    tree.a[4] := 0.0;
  185.    tree.b[4] := 0.0;
  186.    tree.c[4] := 0.0;
  187.    tree.d[4] := 0.5;
  188.    tree.e[4] := 0.0;
  189.    tree.f[4] := 0.0;
  190.    tree.p[4] := 1.0;
  191.    tree.xs := 800.0;
  192.    tree.ys := 800.0;
  193.    tree.xo := 320.0;
  194.    tree.yo := 0.0;
  195.    square.a[1] := 0.5;
  196.    square.b[1] := 0.0;
  197.    square.c[1] := 0.0;
  198.    square.d[1] := 0.5;
  199.    square.e[1] := 0.5;
  200.    square.f[1] := 0.5;
  201.    square.p[1] := 0.25;
  202.    square.a[2] := 0.5;
  203.    square.b[2] := 0.0;
  204.    square.c[2] := 0.0;
  205.    square.d[2] := 0.5;
  206.    square.e[2] := 0.0;
  207.    square.f[2] := 0.5;
  208.    square.p[2] := 0.50;
  209.    square.a[3] := 0.5;
  210.    square.b[3] := 0.0;
  211.    square.c[3] := 0.0;
  212.    square.d[3] := 0.5;
  213.    square.e[3] := 0.5;
  214.    square.f[3] := 0.0;
  215.    square.p[3] := 0.75;
  216.    square.a[4] := 0.5;
  217.    square.b[4] := 0.0;
  218.    square.c[4] := 0.0;
  219.    square.d[4] := 0.5;
  220.    square.e[4] := 0.0;
  221.    square.f[4] := 0.0;
  222.    square.p[4] := 1.0;
  223.    square.xs := 300.0;
  224.    square.ys := 300.0;
  225.    square.xo := 174.0;
  226.    square.yo := 32.0;
  227. END InitData;
  228.  
  229. PROCEDURE Initialize();
  230.  
  231. (* This one initializes the program. It initializes the data and paints the
  232.    screen gray. *)
  233.  
  234. VAR temp : ARRAY [0..3] OF INTEGER;
  235.  
  236. BEGIN
  237.    windopen := FALSE; (* no window opened yet *)
  238.    InitData;
  239.    dummy := WindGet(0,WFWORKXYWH,xdesk,ydesk,wdesk,hdesk);
  240.    dummy := VsfInterior(GEMState.handle,2);
  241.    dummy := VsfStyle(GEMState.handle,4);
  242.    dummy := VsfColor(GEMState.handle,1);
  243.    temp[0] := xdesk;
  244.    temp[1] := ydesk;
  245.    temp[2] := xdesk + wdesk - 1;
  246.    temp[3] := ydesk + hdesk - 1;
  247.    HideMouse;
  248.    VBar(GEMState.handle,temp);
  249.    ShowMouse;
  250. END Initialize;
  251.  
  252. PROCEDURE CloseWindow();
  253.  
  254. (* Closes the currently open window and sets windopen to FALSE. The window
  255.    is deleted after it is closed. *)
  256.  
  257. BEGIN
  258.    dummy := WindClose(windhandle);
  259.    dummy := GrafShrinkbox((xdesk + (wdesk DIV 2)),(ydesk + (hdesk DIV 2)),
  260.                          GEMState.wbox,GEMState.hbox,xdesk,ydesk,wdesk,hdesk);  
  261.    dummy := WindDelete(windhandle);
  262.    windopen := FALSE;
  263. END CloseWindow;
  264.  
  265. PROCEDURE OpenWindow(name : ADDRESS);
  266.  
  267. (* Opens a window with only a title bar. When it takes 4 minutes to redraw
  268.    the screen we don't want sizers, etc. *)
  269.  
  270. VAR features    : INTEGER;
  271.     i1,i2       : INTEGER;
  272.  
  273. BEGIN
  274.    features := 0;
  275.    SetBit(NAME,features);
  276.    windhandle := WindCreate(features,xdesk,ydesk,wdesk,hdesk);
  277.    AddrToInts(name,i1,i2);
  278.    dummy := WindSet(windhandle,WFNAME,i1,i2,0,0);
  279.    dummy := GrafGrowbox((xdesk + (wdesk DIV 2)),(ydesk + (hdesk DIV 2)),
  280.                          GEMState.wbox,GEMState.hbox,xdesk,ydesk,wdesk,hdesk);  
  281.    dummy := WindOpen(windhandle,xdesk,ydesk,wdesk,hdesk);
  282.    windopen := TRUE;
  283. END OpenWindow;
  284.  
  285. PROCEDURE Random() : REAL;
  286.  
  287. (* Returns a random REAL between 0 and 1 *)
  288.  
  289. VAR l : LONGINT;
  290.     f : REAL;
  291.  
  292. BEGIN
  293.    l := random();
  294.    l := l MOD 30000D;
  295.    f := FLOAT(l);
  296.    f := f / 30000.0;
  297.    RETURN(f);
  298. END Random;
  299.  
  300. PROCEDURE Decode(data  : DataRec;
  301.                  name  : ADDRESS);
  302.  
  303. (* This is the procedure that does all the work. It is based on a small basic
  304.    program that was included in the above cited article. For an explanation
  305.    of how it works, see the article. They explain it better than I could. *)
  306.  
  307. VAR wx,wy,ww,wh : INTEGER;
  308.     temp        : ARRAY [0..3] OF INTEGER;
  309.     where       : ARRAY [0..1] OF INTEGER;
  310.     x,y         : REAL;
  311.     newx,newy   : REAL;
  312.     pk          : REAL;
  313.     k           : INTEGER;
  314.     i           : CARDINAL;
  315.  
  316. BEGIN
  317.    HideMouse;
  318.    IF windopen THEN
  319.       CloseWindow;
  320.    END;
  321.    OpenWindow(name);
  322.    dummy := WindGet(windhandle,WFWORKXYWH,wx,wy,ww,wh);
  323.    dummy := VsfInterior(GEMState.handle,2);
  324.    dummy := VsfStyle(GEMState.handle,8);
  325.    dummy := VsfColor(GEMState.handle,0);
  326.    dummy := VswrMode(GEMState.handle,1);
  327.    temp[0] := wx;
  328.    temp[1] := wy;
  329.    temp[2] := wx + ww - 1;
  330.    temp[3] := wy + wh - 1;
  331.    VBar(GEMState.handle,temp); (* Clear the window *)
  332.    dummy := VsmType(GEMState.handle,1);
  333.    dummy := VsmHeight(GEMState.handle,1);
  334.    dummy := VsmColor(GEMState.handle,1);
  335.    x := 0.0;
  336.    y := 0.0;
  337.    FOR i := 1 TO 65000 DO
  338.       pk := Random();
  339.       IF pk <= data.p[1] THEN
  340.          k := 1;
  341.       ELSIF pk <= data.p[2] THEN
  342.          k := 2;
  343.       ELSIF pk <= data.p[3] THEN
  344.          k := 3;
  345.       ELSE
  346.          k := 4;
  347.       END;
  348.       newx := data.a[k] * x + data.b[k] * y + data.e[k];
  349.       newy := data.c[k] * x + data.d[k] * y + data.f[k];
  350.       x := newx;
  351.       y := newy;
  352.       where[0] := TRUNC(x * data.xs + data.xo + 0.5);
  353.       where[1] := TRUNC(y * data.ys + data.yo + 0.5);
  354.       where[1] := 400 - where[1];
  355.       IF i > 10 THEN
  356.          VPmarker(windhandle,1,where);
  357.       END;
  358.    END;
  359.    ShowMouse;
  360. END Decode;
  361.  
  362. PROCEDURE DoMenu();
  363.  
  364. (* This procedure contains the event loop that is the driver for the program.
  365.    Notice that redraw messages are not handled. It takes 4 minutes to redraw
  366.    the screen, and I didn't want to mess with buffering the data somewhere,
  367.    so I don't do redraws. One effect of this decision is that the INFO
  368.    box is only drawn at program start, before any windows are opened. In
  369.    addition, any accessories opened on top of a window will destroy the
  370.    underlying data. *)
  371.  
  372. VAR flags         : INTEGER;
  373.     menuaddr      : ADDRESS;
  374.     event         : INTEGER;
  375.     endprogram    : BOOLEAN;
  376.     keycode       : INTEGER;
  377.     messagebuffer : ARRAY [0..7] OF INTEGER;
  378.  
  379. BEGIN
  380.    dummy := RsrcGAddr(0,MAINMENU,menuaddr);
  381.    dummy := MenuBar(menuaddr,1);
  382.    DoDialog(INFOBOX);
  383.    endprogram := FALSE;
  384.    flags := 0;
  385.    SetBit(MUMESAG,flags);
  386.    SetBit(MUKEYBD,flags);
  387.    REPEAT
  388.       event := EvntMulti(flags,
  389.                          0,0,0,
  390.                          0,0,0,0,0,
  391.                          0,0,0,0,0,
  392.                          ADR(messagebuffer),
  393.                          0,0,
  394.                          dummy,dummy,dummy,
  395.                          dummy,keycode,dummy);
  396.       dummy := WindUpdate(BEGUPDATE);
  397.       IF TestBit(MUMESAG,event) THEN
  398.          CASE messagebuffer[0] OF
  399.             MNSELECTED : CASE messagebuffer[4] OF
  400.                             QUIT     : endprogram := TRUE; |
  401.                             INFO     : ; |
  402.                             TRIANGLE : Decode(triangle,
  403.                                               ADR(' Sierpinski Triangle ')); |
  404.                             FERN     : Decode(fern,
  405.                                               ADR(' Fern ')); |
  406.                             TREE     : Decode(tree,
  407.                                               ADR(' Fractal Tree ')); |
  408.                             SQUARE   : Decode(square,
  409.                                               ADR(' Square ')); |
  410.                          END;
  411.                          dummy := MenuTnormal(menuaddr,messagebuffer[3],1);
  412.          ELSE
  413.             ;
  414.          END;
  415.       END;
  416.       IF TestBit(MUKEYBD,event) THEN
  417.          ; (* We could add some hotkeys here later. *)
  418.       END;
  419.       dummy := MenuBar(menuaddr,1);
  420.       dummy := WindUpdate(ENDUPDATE);
  421.    UNTIL endprogram;
  422.    IF windopen THEN
  423.       CloseWindow;
  424.    END;
  425.    dummy := MenuBar(menuaddr,0);
  426. END DoMenu;
  427.  
  428. BEGIN
  429.    IF GEMInit(ADR('ifs.rsc')) THEN
  430.       Initialize;
  431.       DoMenu;
  432.    END;
  433.    GEMTerm;
  434. END IFS.
  435.